Despite being caught off guard by the virus initially, the data shows that the number of new cases and fatalities per day is decreasing.


Source: https://github.com/nytimes/covid-19-data

The COVID-19 pandemic continues to affect people in various ways. However, the impact of the pandemic are not the same across the board.


By doing further analysis, we found new evidences that some racial and ethnic minority groups are being disproportionately affected by COVID-19.


The challenges of the COVID-19 pandemic are different for various socio-demographic groups and in this page, we focus on how the pandemic has affected older adults.


Not only the effects of COVID 19 are different between age groups and races, within an age group there is difference between genders as well.


The distribution of new cases is not the same geographically, in some areas the virus is getting out of control while other areas manage to contain the virus sucessfully.


In here you can find COVID 19 statistics for a specifics county.


This report would be possible with data from:

---
title: "A Brief Report of COVID 19 Situation in United States"
output: 
  flexdashboard::flex_dashboard:
    storyboard: true
    social: menu
    source: embed
---
  
```{r setup, include=FALSE}
library('flexdashboard')
library('DT')
library('tidyr')
library('tidyverse')
library('plotly')
library('readr')
library('dplyr')
library('zoo')
library('leaflet')
library('tigris')
library('blscrapeR')
library('flexdashboard')
#wd = "/srv/shiny-server/myapp/"
wd = "C:/Users/nghia/OneDrive/Documents/tem"
setwd(wd)
source("functions.R")

county_file_url = "https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-counties.csv"
state_file_url = "https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-states.csv"
us_file_url     = "https://raw.githubusercontent.com/nytimes/covid-19-data/master/us.csv"
fatality_by_gender_url = "http://data.cdc.gov/resource/9bhg-hcku.csv?$limit=10000&$$app_token=Y21ef2T1w3Ub7VVJAF8l3sGGd"
population_by_county_url = "https://raw.githubusercontent.com/nytimes/covid-19-data/63d02b9d1073eff62827daf155a4fe1ef4ab7188/pop_est_2019.csv"

covid19_county_data = read_csv(
  url(county_file_url)
  )
covid19_nation_data = read_csv(
  url(us_file_url)
  )
covid19_state_data = read_csv(
  url(state_file_url)
  )
fatality_by_gender = read_csv(
  url(fatality_by_gender_url)
  )
population_by_county = read_csv(
  url(population_by_county_url)
  )

covid19_county_data$date = as.Date(covid19_county_data$date)
covid19_nation_data$date = as.Date(covid19_nation_data$date)
covid19_county_data$fips = as.character(covid19_county_data$fips)

#Time series for national data
covid19_national_timeseries = diff(covid19_nation_data)
covid19_national_timeseries = replaceNA(covid19_national_timeseries)
#fatality by gender for national data
fatality_by_gender_data = fatality_by_gender[fatality_by_gender$state == "United States", ] 

#national new cases
temp_data = covid19_county_data
temp_data[ ,c("X", "deaths")] = NULL
temp_data = temp_data[complete.cases(temp_data), ]
temp_data = temp_data %>% pivot_wider(names_from = date, values_from = cases)
index = ncol(temp_data)
temp_new_cases = list()
for(i in (index - 7):index){
  temp_new_cases[[i]] = temp_data[,i] - temp_data[,i-1]
  }
new_cases = data.frame(temp_new_cases[[index-6]],
                            temp_new_cases[[index-5]],
                            temp_new_cases[[index-4]],
                            temp_new_cases[[index-3]],
                            temp_new_cases[[index-2]],
                            temp_new_cases[[index-1]],
                            temp_new_cases[[index]])
total_cases = temp_data[ ,ncol(temp_data)]
new_cases_7days_average = rowMeans(new_cases)
new_cases_by_county = data.frame(temp_data$state,
                                 temp_data$county,
                                 temp_data$fips,
                                 new_cases_7days_average,
                                 total_cases,
                                 row.names = NULL)
colnames(new_cases_by_county) = c("State", "County", 
                                  "fips", "new_cases_7day_average", "total_cases")
new_cases_per_100k = merge(new_cases_by_county, population_by_county, by = "fips")
new_cases_per_100k$new_cases_7day_average[new_cases_per_100k$new_cases_7day_average < 0] = 0
new_cases_per_100k = new_cases_per_100k %>% mutate(new_cases_per_100k = new_cases_7day_average*100000/population,
                                                    total_cases_per_100k = total_cases*100000/population)
#datatable
table_cases  = new_cases_per_100k[, c("State", "County", 
                                      "total_cases", "total_cases_per_100k",
                                      "new_cases_7day_average", "new_cases_per_100k")]
table_cases$total_cases = round(table_cases$total_cases, 2)
table_cases$new_cases_7day_average = round(table_cases$new_cases_7day_average, 2)
table_cases$new_cases_per_100k = round(table_cases$new_cases_per_100k, 2)
table_cases$total_cases_per_100k = round(table_cases$total_cases_per_100k, 2)
colnames(table_cases) = c("State", "County", 
                          "Total Cases", "Per 100,000", 
                          "Average 7-day Daily Cases", "Per 100,000")

#national new deaths
temp_data = covid19_county_data
temp_data[ ,c("X", "cases")] = NULL
temp_data = temp_data[complete.cases(temp_data), ]
temp_data = temp_data %>% pivot_wider(names_from = date, values_from = deaths)
index = ncol(temp_data)
temp_new_deaths = list()
for(i in (index - 7):index){
  temp_new_deaths[[i]] = temp_data[,i] - temp_data[,i-1]
}
new_deaths = data.frame(temp_new_deaths[[index-6]],
                       temp_new_deaths[[index-5]],
                       temp_new_deaths[[index-4]],
                       temp_new_deaths[[index-3]],
                       temp_new_deaths[[index-2]],
                       temp_new_deaths[[index-1]],
                       temp_new_deaths[[index]])
total_deaths = temp_data[ ,ncol(temp_data)]
new_deaths_7days_average = rowMeans(new_deaths)
new_deaths_by_county = data.frame(temp_data$state,
                                 temp_data$county,
                                 temp_data$fips,
                                 new_deaths_7days_average,
                                 total_deaths,
                                 row.names = NULL)
colnames(new_deaths_by_county) = c("State", "County", 
                                   "fips", "new_deaths_7day_average", "total_deaths")
new_deaths_per_100k = merge(new_deaths_by_county, population_by_county, by = "fips")
new_deaths_per_100k$new_deaths_7day_average[new_deaths_per_100k$new_deaths_7day_average < 0] = 0
new_deaths_per_100k = new_deaths_per_100k %>% mutate(new_deaths_per_100k = new_deaths_7day_average*100000/population,
                                                   total_deaths_per_100k = total_deaths*100000/population)
#datatable
table_death  = new_deaths_per_100k[, c("State", "County", 
                                       "total_deaths", "total_deaths_per_100k",
                                       "new_deaths_7day_average", "new_deaths_per_100k")]
table_death$total_deaths = round(table_death$total_deaths, 2)
table_death$new_deaths_7day_average = round(table_death$new_deaths_7day_average, 2)
table_death$new_deaths_per_100k = round(table_death$new_deaths_per_100k, 2)
table_death$total_deaths_per_100k = round(table_death$total_deaths_per_100k, 2)
colnames(table_death) = c("State", "County", 
                          "Total Deaths", "Per 100,000", 
                          "Average 7-day Daily Deaths", "Per 100,000")
#create data table
data_table = merge(new_cases_per_100k, new_deaths_per_100k, by = "fips")
data_table = data_table[ ,c(2,3,4,5,7,8,11,12,14,15)]
data_table = data_table[ ,c(1,2,3,5,4,6,7,9,8,10)]

data_table$new_cases_7day_average = round(data_table$new_cases_7day_average, 2)
data_table$new_cases_per_100k = round(data_table$new_cases_per_100k, 2)
data_table$total_cases_per_100k = round(data_table$total_cases_per_100k, 2)
data_table$new_deaths_7day_average = round(data_table$new_deaths_7day_average, 2)
data_table$new_deaths_per_100k = round(data_table$new_deaths_per_100k, 2)
data_table$total_deaths_per_100k = round(data_table$total_deaths_per_100k)

colnames(data_table) = c("State", "County", 
                         "New Cases 7-day Average", "Per 100,000",
                         "Total Cases", "Per 100,000",
                         "New Deaths 7-day Average", "Per 100,000", 
                         "Total Deaths", "Per 100,000")
#plotting 
by_gender_age = plot_gender_age(fatality_by_gender_data)
pie_chart_fatality_by_gender = by_gender(fatality_by_gender_data)
bar_plot_fatality_by_gender = by_age(fatality_by_gender_data)
new_cases_timeseries = plot_case(covid19_national_timeseries)
new_deaths_timeseries = plot_death(covid19_national_timeseries)
timeseries <- subplot(new_cases_timeseries, 
                      new_deaths_timeseries, 
                      nrows = 2,
                      shareX = TRUE)
timeseries = timeseries %>% layout(title = "Day-over-Day Cases and Fatality")
heatmap_new_cases_by_county = plot_growth(new_cases_per_100k)
```

### Despite being caught off guard by the virus initially, the data shows that the number of new cases and fatalities per day is decreasing.

```{r}
timeseries
```

***
Source: https://github.com/nytimes/covid-19-data

- Since the first COVID 19 case in January 20, 2020, more than ***6,01 millions*** cases has been confirmed as of ***8/31/2020***

- Out of ***6.03 millions cases***, more than ***183 thousands people*** have lost their life. On average, ***953 people*** die daily due to COVID-19.

- At the day of this report (08/30/2020), ***44,002 new cases*** have been confirmed and ***464 new fatalities*** have been reported.

### The COVID-19 pandemic continues to affect people in various ways. However, the impact of the pandemic are not the same across the board.

```{r include = FALSE}
by_race = read.csv('C:/Users/nghia/OneDrive/Documents/tem/by_race.csv')
by_race$Race.Ethnicity = factor(by_race$Race.Ethnicity, 
                                levels = unique(by_race$Race.Ethnicity)[order(by_race$cases_count, 
                                                                              decreasing = FALSE)])
death_by_race = plot_ly(data = by_race,
                       y = ~Race.Ethnicity,
                       x = ~death_count,
                       name = "Confirmed Fatality",
                       color = I("steelblue"),
                       type = 'bar', 
                       orientation = 'h',
                       hoverinfo = 'text',
                       text = ~paste('
Confirmed Fatality: ', prettyNum(by_race$death_count, big.mark = ",", scientific = FALSE), "
Percentage: ", paste0(by_race$death_percent, "%"))) death_by_race = death_by_race %>% layout( legend = list(x = 1, y = 0), xaxis = list(title = "", fixedrange = TRUE), yaxis = list(title = "", fixedrange = TRUE), showlegend = TRUE) death_by_race = death_by_race %>% config(modeBarButtonsToRemove = c("zoomInGeo", "zoomOutGeo", "hoverClosestGeo", 'hoverClosestCartesian', "select2d", "lasso2d", "toImage", "pan2d", 'toggleSpikelines', 'hoverCompareCartesian'), displaylogo = FALSE) cases_by_race = plot_ly(data = by_race, y = ~Race.Ethnicity, x = ~cases_count, name = "Confirmed Cases", color = I("darkslategray4"), type = 'bar', orientation = 'h', hoverinfo = 'text', text = ~paste('
Confirmed Cases: ', prettyNum(by_race$cases_count, big.mark = ",", scientific = FALSE), "
Percentage: ", paste0(by_race$cases_percent, "%"))) %>% layout( legend = list(x = 1, y = 0), xaxis = list(title = "", fixedrange = TRUE), yaxis = list(title = "", fixedrange = TRUE), showlegend = TRUE) %>% config(modeBarButtonsToRemove = c("zoomInGeo", "zoomOutGeo", "hoverClosestGeo", 'hoverClosestCartesian', "select2d", "lasso2d", "toImage", "pan2d", 'toggleSpikelines', 'hoverCompareCartesian'), displaylogo = FALSE) plot_by_race = subplot(cases_by_race, death_by_race, shareY = TRUE) plot_by_race = plot_by_race %>% layout(title = "Cases and Fatality by Races") ``` ```{r} plot_by_race ``` *** - Cases by Race/Ethnicity, data from 4,508,060 cases. Race/Ethnicity was available for 2,224,387 (49%) cases. - Deaths by Race/Ethnicity, Data from 135,840 deaths. Race/Ethnicity was available for 111,958 (82%) deaths. - Caucasian population account for nearly 51% of the confirmed fatality and 40.4% of the confirmed positive cases. - Although Hispanic population account for 31% of the confirmed cases, only 6.9% of the fatalities are Hispanic. ### By doing further analysis, we found new evidences that some racial and ethnic minority groups are being disproportionately affected by COVID-19. ```{r include = FALSE} by_race = read.csv('C:/Users/nghia/OneDrive/Documents/tem/by_race.csv') by_race$Race.Ethnicity <- factor(by_race$Race.Ethnicity, levels = unique(by_race$Race.Ethnicity)[order(by_race$cases_per_100k, decreasing = FALSE)]) death_per_100k_by_race = plot_ly(data = by_race, y = ~Race.Ethnicity, x = ~death_per_100k, name = "Fatality per 100,000", color = I("steelblue"), type = 'bar', orientation = 'h', hoverinfo = 'text', text = ~paste('
Fatality per 100,000: ', prettyNum(round(by_race$death_per_100k, 3), big.mark = ",", scientific = FALSE))) %>% layout( legend = list(x = 1, y = 0), xaxis = list(title = "", fixedrange = TRUE), yaxis = list(title = "", fixedrange = TRUE), showlegend = TRUE) %>% config(modeBarButtonsToRemove = c("zoomInGeo", "zoomOutGeo", "hoverClosestGeo", 'hoverClosestCartesian', "select2d", "lasso2d", "toImage", "pan2d", 'toggleSpikelines', 'hoverCompareCartesian'), displaylogo = FALSE) cases_per_100k_by_race = plot_ly(data = by_race, y = ~Race.Ethnicity, x = ~cases_per_100k, name = "Cases per 100,000", color = I("darkslategray4"), type = 'bar', orientation = 'h', hoverinfo = 'text', text = ~paste('
Cases per 100,000: ', prettyNum(round(by_race$cases_per_100k, 3), big.mark = ",", scientific = FALSE))) %>% layout( legend = list(x = 1, y = 0), xaxis = list(title = "", fixedrange = TRUE), yaxis = list(title = "", fixedrange = TRUE), showlegend = TRUE) %>% config(modeBarButtonsToRemove = c("zoomInGeo", "zoomOutGeo", "hoverClosestGeo", 'hoverClosestCartesian', "select2d", "lasso2d", "toImage", "pan2d", 'toggleSpikelines', 'hoverCompareCartesian'), displaylogo = FALSE) plot_per_100k_by_race = subplot(cases_per_100k_by_race, death_per_100k_by_race, shareY = TRUE) plot_per_100k_by_race = plot_per_100k_by_race %>% layout(title = "Cases and Fatality per 100,000 by Races") ``` ```{r} plot_per_100k_by_race ``` *** - If we compare using number of confirmed positive cases, Hispanic, Pacific Islander and Other Non-Hispanic are hit hardest. Their numbers of cases per 100,000 are nearly triple that of White and Asian. - If we compare using number of confirmed fatality, ***Black Americans and Other non-Hispanic are at highest risk for fatality and they suffer from disproportionate deaths due to COVID 19***. - The overall fatalities per 100,000 for Black Americans is about 2 times as high as it is for white and Asian Americans. ### The challenges of the COVID-19 pandemic are different for various socio-demographic groups and in this page, we focus on how the pandemic has affected older adults. ```{r} by_age = read.csv('C:/Users/nghia/OneDrive/Documents/tem/by_age.csv', stringsAsFactors = FALSE) by_age$Age.Group = factor(by_age$Age.Group, levels = by_age$Age.Group) death_by_age = plot_ly(data = by_age, y = ~Age.Group, x = ~death_count, name = "Confirmed Fatality", color = I("steelblue"), type = 'bar', orientation = 'h', hoverinfo = 'text', text = ~paste('
Confirmed Fatality: ', prettyNum(by_age$death_count, big.mark = ",", scientific = FALSE), "
Percentage: ", paste0(by_age$death_percent, "%"))) death_by_age = death_by_age %>% add_lines(x = ~death_rate, line = list(color = 'rgb(205, 12, 24)', width = 4), name = "Fatality Rate", xaxis = "x2", hoverinfo = 'text', text = ~paste('
Fatality Rate: ', paste0(by_age$death_rate, "%"), '
Age Group: ', by_age$Age.Group)) death_by_age = death_by_age %>% config(modeBarButtonsToRemove = c("zoomInGeo", "zoomOutGeo", "hoverClosestGeo", 'hoverClosestCartesian', "select2d", "lasso2d", "toImage", "pan2d", 'toggleSpikelines', 'hoverCompareCartesian'), displaylogo = FALSE) death_by_age = death_by_age %>% layout(legend = list(x = 1, y = 0), xaxis = list(title = "", fixedrange = TRUE), yaxis = list(title = "", fixedrange = TRUE), xaxis2 = list(overlaying = "x", fixedrange = TRUE, side = "right"), showlegend = TRUE) cases_by_age = plot_ly(data = by_age, y = ~Age.Group, x = ~cases_count, name = "Confirmed Cases", color = I("darkslategray4"), type = 'bar', orientation = 'h', hoverinfo = 'text', text = ~paste('
Confirmed Cases: ', prettyNum(by_age$cases_count, big.mark = ",", scientific = FALSE), "
Percentage: ", paste0(by_age$cases_percent, "%"))) %>% layout( legend = list(x = 1, y = 0), xaxis = list(title = "", fixedrange = TRUE), yaxis = list(title = "", fixedrange = TRUE), showlegend = TRUE) %>% config(modeBarButtonsToRemove = c("zoomInGeo", "zoomOutGeo", "hoverClosestGeo", 'hoverClosestCartesian', "select2d", "lasso2d", "toImage", "pan2d", 'toggleSpikelines', 'hoverCompareCartesian'), displaylogo = FALSE) plot_by_age = subplot(cases_by_age, death_by_age, shareY = TRUE) plot_by_age = plot_by_age %>% layout(title = "Cases and Fatality by Age Groups") ``` ```{r} plot_by_age ``` *** - Cases by age group, data from 4,508,060 cases. Age group was available for 4,346,546 (96%) cases. - Deaths by age group: data from 135,840 deaths. Age group was available for 135,823 (99%) deaths. - Although people from 18 - 64 year-old account for 76.3% confirmed cases, ***79.3% of fatalities are from people older than 64 year-old***. - Fatality rate changes sharply from 65 - 74 years group, staggeringly rises from 8.5% (65 - 74 years) to 29.3% (85 years and older). ### Not only the effects of COVID 19 are different between age groups and races, within an age group there is difference between genders as well. ```{r} by_gender_age = by_gender_age %>% layout(title = "Cases and Fatality by Genders and Age Groups") by_gender_age ``` *** - Over 54% of fatalities are male. - In every age groups, we always have more fatality in male group than that of female, except 85+ years. - Considering that we have approximately equal cases distribution between male and female in nearly every age groups, we can conclude that ***male population is more susceptible to dying due to COVID 19***. ### The distribution of new cases is not the same geographically, in some areas the virus is getting out of control while other areas manage to contain the virus sucessfully. ```{r} heatmap_new_cases_by_county ``` *** - While the Southwestern states largely have the virus under control, the pandemic is exploding in the Bible Belt and the Northern states. - Despite highest case and fatality count, the Rust Belt has successfully contained the spread of the virus. ### In here you can find COVID 19 statistics for a specifics county. ```{r} datatable(data_table) ``` *** This report would be possible with data from: - NY Times COVID-19 data: https://github.com/nytimes/covid-19-data - Center of Disease and Control: https://www.cdc.gov/coronavirus/2019-ncov/cases-updates/index.html - US Census: https://www.census.gov/